************************************************************************
*                            PRICE.FOR                                 *
*                                                                      *
*  PROGRAM: SIMRAND I                                                  *
*  MODULE:  1.5.3.4                                                    *
*  DATE:    02/04/85                                                   *
*                                                                      *
*  THIS IS THE SUBROUTINE PRICE.  IT CALCULATES THE TASK PRICES AND    *
*  THE TOTAL PRICES FOR A SINGLE MONTE CARLO TRIAL USING THE RANDOM    *
*  VARIABLE VALUES GENERATED BY THE SUBROUTINE VARCAL.  IT DETERMINES  *
*  THE MINIMUM TOTAL PRICE AND THE ASSOCIATED STEP PRICES FOR A        *
*  TRIAL, AND INCREMENTS THE MINIMUM ALTERNATIVE HISTOGRAM.  IT        *
*  CALCULATES UTILITY FUNCTION VALUES FOR THE MINIMUM TOTAL PRICE.     *
*                                                                      *
*----------------------------------------------------------------------*
*                     CONFIGURATION CHANGES                            *
*                                                                      *
*    DATE                  CHANGE                                      *
*                                                                      *
*  12/05/84  * ORIGINAL.                                               *
*  02/04/85  * MODULE  1: JDIAG .EQ. 2.                                *
*            * MODULE 10: JDIAG .EQ. 2.                                *
*                         ADD: IF ((JDIAG .EQ. 1 .AND. ) ...) ETC.     *
*            * MODULE 13: JDIAG .EQ. 2.                                *
*                                                                      *
************************************************************************

$TITLE:'PRICE.LST'
$DEBUG
$NOFLOATCALLS
$STORAGE:2

************************************************************************

      SUBROUTINE PRICE

************************************************************************


***** INITIALIZE.  {MODULE 1}

      LOGICAL INALT,UCAL

$INCLUDE:'INITIAL.FOR'

      IF (JDIAG .EQ. 2) THEN
         WRITE  (*,100)
100      FORMAT (/1X,4X,'ENTER SUBROUTINE PRICE')
      ENDIF

      INALT = .FALSE.

***   {END MODULE 1}


***** START (IA) DO LOOP TO CALCULATE PRICES.  {MODULE 2}

      DO 130 IA=1,NIA


*****    IF ALTERNATIVE IA NOT TO BE INCLUDED IN RUN (INCLUD .EQ. 0),
*****    SET PMTX(IA,IP) = 0.0, ELSE CALCULATE STEP AND TOTAL PRICES.
*****    {MODULE 3}

         INCLUD = ITASK(IA,NIX)

         IF (INCLUD .EQ. 0) THEN


*****       ALTERNATIVE IA NOT INCLUDED IN RUN (INCLUD .EQ. 0).
*****       {MODULE 4}

            DO 110 IP=1,NIP
               PMTX(IA,IP) = 0.0
110         CONTINUE

***         {END MODULE 4}


*****    {CONTINUE MODULE 3}

         ELSE


*****       ALTERNATIVE IA INCLUDED IN RUN (INCLUD .EQ. 1).
*****       CALCULATE STEP AND TOTAL PRICES PMTX(IA,IP).
*****       {MODULES 4-5}

$INCLUDE:'EQNS.FOR'

***         {END MODULES 4-5}


*****       IF NO ALTERNATIVE YET INCLUDED IN TRIAL OR THIS ALTERNATIVE
*****       HAS THE MINIMUM TOTAL PRICE FOR THE RUN,
*****       PMIN(IP) = PMTX(IA,IP).  {MODULE 6}

            IF ((.NOT. INALT) .OR. (PMTX(IA,NIP) .LE. PMIN(NIP))) THEN

*              SET PMIN(IP) EQUAL TO PRICES OF THIS ALTERNATIVE.

               DO 120 IP=1,NIP 
                  PMIN(IP) = PMTX(IA,IP)
120            CONTINUE

               IAMIN = IA
               INALT = .TRUE.

            ENDIF

***         {END MODULE 6}

         ENDIF

***      END IF (INCLUD .EQ. 0).  {END MODULE 3}

130   CONTINUE

***   END (IA) DO LOOP TO CALCULATE PRICES.  {END MODULE 2}


***** CALCULATE THE UTILITY FUNCTION VALUES UTIL(II) FOR PMIN(NIP).
***** {MODULE 7}

      DO 150 II=1,NII

         IF (PMIN(NIP) .LE. UDATA(II,1)) THEN

            UTIL(II) = 1.0

         ELSE

            UCAL = .FALSE.

            DO 140 ID=1,NIU,2

               IF (UDATA(II,ID+1) .EQ. 0.0) THEN

                  UTIL(II) = 0.0
                  UCAL     = .TRUE.

               ELSEIF (PMIN(NIP) .LE. UDATA(II,ID+2)) THEN

                  UTIL(II) = UCOEF(II,ID)*PMIN(NIP) + UCOEF(II,ID+1)
                  UCAL     = .TRUE.

               ENDIF

               IF (UCAL) GO TO 150

140         CONTINUE

         ENDIF

150   CONTINUE

***   {END MODULE 7}


***** INCREMENT THE MINIMUM ALTERNATIVE HISTOGRAM.
***** {MODULE 8}

      IHALT(IAMIN) = IHALT(IAMIN) + 1

***   {END MODULE 8}


***** WRITE PMTX(IA,IP).  {MODULE 9}

      IF (JDIAG .EQ. 2) THEN

         WRITE  (*,*) 'PRICE MATRIX PMTX(IA,IP) FOR THIS TRIAL'

         DO 180 IA=1,NIA

            IF (NIP .LE. 5) THEN
               WRITE (*,160) IA,(PMTX(IA,IP),IP=1,NIP)
            ELSE
               WRITE (*,160) IA,(PMTX(IA,IP),IP=1,5)
               WRITE (*,170)    (PMTX(IA,IP),IP=6,NIP)
            ENDIF

160         FORMAT (1X,I5,3X,1P5E14.4)
170         FORMAT (1X,   8X,1P5E14.4)

180      CONTINUE

      ENDIF

***   {END MODULE 9}


***** WRITE PMIN(IP).  {MODULE 10}

      IF ((JDIAG .EQ. 1) .AND. (MOD(IITR,100) .EQ. 0))
     *   WRITE (*,190) PMIN(NIP)

      IF (JDIAG .EQ. 2) THEN

         WRITE  (*,*) 'MINIMUM PRICES FOR THIS TRIAL'

         IF (IP .LE. 5) THEN
            WRITE  (*,190) (PMIN(IP),IP=1,5)
         ELSE
            WRITE  (*,190) (PMIN(IP),IP=1,5)
            WRITE  (*,200) (PMIN(IP),IP=6,NIP)
         ENDIF

190      FORMAT (1X,'PMIN',4X,1P5E14.4)
200      FORMAT (1X,       8X,1P5E14.4)

      ENDIF

***   {END MODULE 10}


***** WRITE UTIL(II).  {MODULE 11}

      IF (JDIAG .EQ. 2) THEN

         WRITE  (*,*) 'UTILITY FUNCTION VALUES FOR THIS TRIAL'

         IF (NII .LE. 5) THEN
            WRITE  (*,210) (UTIL(II),II=1,NII)
         ELSE
            WRITE  (*,210) (UTIL(II),II=1,5)
            WRITE  (*,220) (UTIL(II),II=6,NII)
         ENDIF

      ENDIF

210   FORMAT (1X,'UTIL',4X,5F14.4)
220   FORMAT (1X,       8X,5F14.4)

***   {END MODULE 11}


***** WRITE IHALT(IA).  {MODULE 12}

      IF (JDIAG .EQ. 2) THEN

         WRITE  (*,*) 'ALTERNATIVE HISTOGRAM IHALT(IA)'

         IF (NIA .LE. 10) THEN
            WRITE  (*,230) (IHALT(IA),IA=1,NIA)
         ELSE
            WRITE  (*,230) (IHALT(IA),IA=1,10)
            WRITE  (*,240) (IHALT(IA),IA=11,NIA)
         ENDIF

230      FORMAT (1X,'IHALT',3X,10I5)
240      FORMAT (1X,        8X,10I5)

      ENDIF

***   {END MODULE 12}


***** EXIT FROM SUBROUTINE PRICE.  {MODULE 13}

      IF (JDIAG .EQ. 2) THEN
         WRITE  (*,999)
999      FORMAT (1X,4X,'EXIT  SUBROUTINE PRICE')
      ENDIF
     
      RETURN

      END

***   {END MODULE 13}

***************************** PRICE.FOR ********************************
